home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Games of Daze
/
Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso
/
x2ftp
/
msdos
/
libs
/
hobbes3
/
hobbes.asm
< prev
next >
Wrap
Assembly Source File
|
1992-08-27
|
18KB
|
722 lines
; Hobbes
; Mode X Library
; Copyright (C) 1992 Court Demas -- cd2a+@cmu.edu
; Portions Copyright (C) 1992 Steven Dollins -- sdollins@uiuc.edu
include hobbes.inc
;----------------------------------------------------------------------------
; Thanks:
;
; Michael Abrash -
; the almight one
;
; Steve Dollins -
; Line, Triangle, Text, Palette code
;
; Sutty & Blair -
; Cool EGA/VGA Book
; Panning/Scrolling/Split Screen routines, etc.
;
; Frederick J. Haab -
; "Scroll" func for viewing virtual screen
;
;----------------------------------------------------------------------------
.DATA
public _RowOffset
_RowOffset dw 1024 dup(?)
public _ClipLeft, _ClipTop, _ClipRight, _ClipBottom
_ClipLeft dw 0
_ClipTop dw 0
_ClipRight dw 4Fh
_ClipBottom dw 3Fh
;Ok, this is a bit much (maybe), but it's the only decent way I know of to
;handle all of the different possible memory arrangements. It has to handle
;different resolutions, split screens, virtual screens, double-buffering,
;etc. If you have a better idea, do tell.
public _ModeX_Segment, _Draw_Offset, _Display_Offset
_ModeX_Segment dw 0A000h
_Draw_Offset dw 00000h
_Display_Offset dw 00000h
public _Split_Line, _Split_Offset, _Page0_Offset, _Page1_Offset
_Split_Line dw 240d
_Split_Offset dw 00000h ;always 0
_Page0_Offset dw 00000h
_Page1_Offset dw 04b00h
public _Physical_Width_Addr, _Physical_Height_Addr
public _Physical_Width_Pix, _Physical_Height_Pix
_Physical_Width_Addr dw 80d
_Physical_Height_Addr dw 60d
_Physical_Width_Pix dw 320d
_Physical_Height_Pix dw 240d
public _Virtual_Width_Addr, _Virtual_Height_Addr
public _Virtual_Width_Pix, _Virtual_Height_Pix, _Virtual_Size
_Virtual_Width_Addr dw 80d
_Virtual_Height_Addr dw 60d
_Virtual_Width_Pix dw 320d
_Virtual_Height_Pix dw 240d
_Virtual_Size dw 04b00h
public _Background_Offset, _Bitmap_Offset, _Pattern_Offset
_Background_Offset dw 09600h
_Bitmap_Offset dw 0f000h
_Pattern_Offset dw 0fffch
public _Double_Buffer, _Current_Page
_Double_Buffer dw 1 ;double-buffer by default
_Current_Page dw 0
extrn _MouseSetPage
;----------------------------------------------------------------------------
; Index/data pairs for CRT Controller registers that differ between
; mode 13h and mode X.
CRTParms label word
dw 00d06h ;vertical total
dw 03e07h ;overflow (bit 8 of vertical counts)
dw 04109h ;cell height (2 to double-scan)
dw 0ea10h ;v sync start
dw 0ac11h ;v sync end and protect cr0-cr7
dw 0df12h ;vertical displayed
dw 00014h ;turn off dword mode
dw 0e715h ;v blank start
dw 00616h ;v blank end
dw 0e317h ;turn on byte mode
CRT_PARM_LENGTH equ (($-CRTParms)/2)
.CODE
;----------------------------------------------------------------------------
; void Set320x200Mode(void);
;
public _Set320x200Mode
_Set320x200Mode proc
push bp
mov bp,sp
push ds
mov ax,@data
mov ds,ax
mov ax,320d
mov _Physical_Width_Pix,ax
mov ax,200d
mov _Physical_Height_Pix,ax
mov _Split_Line,ax
mov ax,80d
mov _Physical_Width_Addr,ax
mov ax,50d
mov _Physical_Height_Addr,ax
mov ah,0
mov al,BYTE PTR [bp+6]
mov bl,al
and bl,07fh
@@setxmode:
mov ah,0 ; set 256-color mode
mov al,13h
int 10h
mov dx,03c4h ; convert to X-mode addressing
mov ax,0604h ; chain mode off
out dx,ax
mov dx,03d4h
mov ax,0014h ; doubleword off
out dx,ax
mov ax,0E317h ; byte mode on
out dx,ax
mov dx,03CEH
mov ax,0FF08h ; all CPU data bits
out dx,ax
mov dx,03c4h ; prepare plane mask reg. for access
mov ax,0f02h
out dx,al
mov ax,WORD PTR[bp+6]
test al,080h
jnz @@dontclear
mov ax,0f02h
out dx,ax ; clear all planes at once
mov ax,0a000h
mov es,ax
xor di,di
mov cx,0ffffh
xor ax,ax
rep stosb
@@dontclear:
pop ds
pop bp
ret
_Set320x200Mode endp
;----------------------------------------------------------------------------
; void Set320x240(void);
;
public _Set320x240Mode
_Set320x240Mode proc
push ds
mov ax,@data
mov ds,ax
push bp
push si
push di
mov ax,320d
mov _Physical_Width_Pix,ax
mov ax,240d
mov _Physical_Height_Pix,ax
mov _Split_Line,ax
mov ax,80d
mov _Physical_Width_Addr,ax
mov ax,60d
mov _Physical_Height_Addr,ax
mov ax,13h ;let the BIOS set standard 256-color
int 10h ; mode (320x200 linear)
mov dx,SC_INDEX
mov ax,0604h
out dx,ax ;disable chain4 mode
mov ax,0100h
out dx,ax ;synchronous reset while switching clocks
mov dx,MISC_OUTPUT
mov al,0e3h
out dx,al ;select 25 MHz dot clock & 60 Hz scanning rate
mov dx,SC_INDEX
mov ax,0300h
out dx,ax ;undo reset (restart sequencer)
mov dx,CRTC_INDEX ;reprogram the CRT Controller
mov al,11h ;VSync End reg contains register write
out dx,al ; protect bit
inc dx ;CRT Controller Data register
in al,dx ;get current VSync End register setting
and al,7fh ;remove write protect on various
out dx,al ; CRTC registers
dec dx ;CRT Controller Index
cld
mov si,offset CRTParms ;point to CRT parameter table
mov cx,CRT_PARM_LENGTH ;# of table entries
@@SetCRTParmsLoop:
lodsw ;get the next CRT Index/Data pair
out dx,ax ;set the next CRT Index/Data pair
loop @@SetCRTParmsLoop
mov dx,SC_INDEX
mov ax,0f02h
out dx,ax ;enable writes to all four planes
mov ax,_ModeX_Segment ;now clear all display memory, 8 pixels
mov es,ax ; at a time
sub di,di ;point ES:DI to display memory
sub ax,ax ;clear to zero-value pixels
mov cx,8000h ;# of words in display memory
rep stosw ;clear all of display memory
pop di
pop si
pop bp
pop ds
ret
_Set320x240Mode endp
;----------------------------------------------------------------------------
; void Set320x400(void);
;
public _Set320x400Mode
_Set320x400Mode proc far
mov ax,320d
mov _Physical_Width_Pix,ax
mov ax,400d
mov _Physical_Height_Pix,ax
mov _Split_Line,ax
mov ax,80d
mov _Physical_Width_Addr,ax
mov ax,100d
mov _Physical_Height_Addr,ax
mov ax,13h
int 10h
mov dx,SC_INDEX
mov al,MEMORY_MODE
out dx,al
inc dx
in al,dx
and al,not 08h
or al,04h
out dx,al
mov dx,GC_INDEX
mov al,GRAPHICS_MODE
out dx,al
inc dx
in al,dx
and al,not 10h
out dx,al
dec dx
mov al,MISCELLANEOUS
out dx,al
inc dx
in al,dx
and al,not 02h
out dx,al
;CONST_TO_INDEXED_REGISTER SC_INDEX, MAP_MASK, 0fh
mov dx,SC_INDEX
mov ax,111100000000b + MAP_MASK
out dx,al
;*** 1111
mov ax,_ModeX_Segment
mov es,ax
sub di,di
mov ax,di
mov cx,8000h
cld
rep stosw
mov dx,CRTC_INDEX
mov al,MAX_SCAN_LINE
out dx,al
inc dx
in al,dx
and al,not 1fh
out dx,al
dec dx
mov al,UNDERLINE
out dx,al
inc dx
in al,dx
and al,not 40h
out dx,al
dec dx
mov al,MODE_CONTROL
out dx,al
inc dx
in al,dx
or al,40h
out dx,al
ret
_Set320x400Mode endp
;----------------------------------------------------------------------------
; void _Set360x480Mode()
;
.code
vptbl dw 06b00h ; horz total
dw 05901h ; horz displayed
dw 05a02h ; start horz blanking
dw 08e03h ; end horz blanking
dw 05e04h ; start h sync
dw 08a05h ; end h sync
dw 00d06h ; vertical total
dw 03e07h ; overflow
dw 04009h ; cell height
dw 0ea10h ; v sync start
dw 0ac11h ; v sync end and protect cr0-cr7
dw 0df12h ; vertical displayed
dw 02d13h ; offset
dw 00014h ; turn off dword mode
dw 0e715h ; v blank start
dw 00616h ; v blank end
dw 0e317h ; turn on byte mode
vpend label word
public _Set360x480Mode
_Set360x480Mode proc
push ds
mov ax,cs
mov ds,ax
push ds
mov ax,@data
mov ds,ax
mov ax,360d
mov _Physical_Width_Pix,ax
mov ax,480d
mov _Physical_Height_Pix,ax
mov _Split_Line,ax
mov ax,90d
mov _Physical_Width_Addr,ax
mov ax,120d
mov _Physical_Height_Addr,ax
pop ds
mov ax,13h ; start with standard mode 13h
int 10h ; let the bios set the mode
mov dx,3c4h ; alter sequencer registers
mov ax,0604h ; disable chain 4
out dx,ax
mov ax,0f02h ; set write plane mask to all bit planes
out dx,ax
push di
xor di,di
mov ax,0a000h ; screen starts at segment A000
mov es,ax
mov cx,21600 ; ((XSIZE*YSIZE)/(4 planes))/(2 bytes per word)
xor ax,ax
cld
rep stosw ; clear the whole of the screen
pop di
mov ax,0100h ; synchronous reset
out dx,ax ; asserted
mov dx,3c2h ; misc output
mov al,0e7h ; use 28 mHz dot clock
out dx,al ; select it
mov dx,3c4h ; sequencer again
mov ax,0300h ; restart sequencer
out dx,ax ; running again
mov dx,3d4h ; alter crtc registers
mov al,11h ; cr11
out dx,al ; current value
inc dx ; point to data
in al,dx ; get cr11 value
and al,7fh ; remove cr0 -> cr7
out dx,al ; write protect
dec dx ; point to index
cld
mov si,offset vptbl
mov cx,((offset vpend)-(offset vptbl)) shr 1
@@outlp:
lodsw
out dx,ax
loop @@outlp
pop ds
ret
_Set360x480Mode endp
;----------------------------------------------------------------------------
; void _WaitForRetrace(void)
;
public _WaitForRetrace
_WaitForRetrace proc
mov dx,03dah
@@swap_retr1:
in al,dx
test al,8
jnz @@swap_retr1
@@swap_retr2:
in al,dx
test al,8
jz @@swap_retr2
ret
_WaitForRetrace endp
;----------------------------------------------------------------------------
; void SetClipPort(int LEFT, int TOP, int RIGHT, int Bottom)
;
public _SetClipPort
_SetClipPort proc
ARG LEFT:WORD, TOP:WORD, RIGHT:WORD, BOTTOM:WORD
push bp
mov bp,sp
push ds
mov ax,@data
mov ds,ax
mov ax,LEFT
mov _ClipLeft,ax
mov ax,TOP
mov _ClipTop,ax
mov ax,RIGHT
mov _ClipRight,ax
mov ax,BOTTOM
mov _ClipBottom,ax
pop ds
pop bp
ret
_SetClipPort endp
;----------------------------------------------------------------------------
; void ShowPage( VRAM_PTR startoffset )
;
public _ShowPage
_ShowPage proc
ARG StartOffsetHigh:BYTE:1, StartOffsetLow:BYTE:1
push bp
mov bp,sp
push ds
mov ax,@data
mov ds,ax
; Wait for display enable to be active (status is active low), to be
; sure both halves of the start address will take in the same frame.
mov bl,START_ADDRESS_LOW ;preload for fastest
mov bh,StartOffsetLow ; flipping once display
mov cl,START_ADDRESS_HIGH ; enable is detected
mov ch,StartOffsetHigh
mov dx,INPUT_STATUS_1
@@WaitDE:
in al,dx
test al,01h
jnz @@WaitDE ;display enable is active low (0 = active)
; Set the start offset in display memory of the page to display.
mov dx,CRTC_INDEX
mov ax,bx
out dx,ax ;start address low
mov ax,cx
out dx,ax ;start address high
; Now wait for vertical sync, so the other page will be invisible when
; we start drawing to it.
mov dx,INPUT_STATUS_1
@@WaitVS:
in al,dx
test al,08h
jz @@WaitVS ;vertical sync is active high (1 = active)
pop ds
pop bp
ret
_ShowPage endp
;----------------------------------------------------------------------------
; void SetDisplay(int x0, int y0);
;
public _SetDisplay
_SetDisplay proc far
ARG x:word,y:word
push bp
mov bp,sp
push ds
mov ax,@data
mov ds,ax
mov ax,[_Virtual_Width_Addr] ; Calculate Offset increment
mul [y] ; for Y
add ax,_Display_Offset ; add it to Start offset
add ax,[x] ; add the column offset for X
mov bh,al ; setup CRTC start addr regs and
; values in word registers for
mov ch,ah ; fast word outs
@@StartAddrEntry:
mov bl,START_ADDRESS_LOW
mov cl,START_ADDRESS_HIGH
call _WaitForRetrace
mov dx,CRTC_INDEX
mov ax,bx
out dx,ax ;start address low
mov ax,cx
out dx,ax ;start address high
pop ds
pop bp
ret
_SetDisplay endp
;----------------------------------------------------------------------------
; void SetSplit(unsigned int Addr);
;
; Mode X (320x240, 256 colors) Set 320x240 mode split screen starting row
; The split screen resides on the bottom half of the screen and has a
; starting address of A000:0000
;
; C near-callable as:
;
; Updates _MainScrnOffset to reflect the existence of the split screen region
; ie -MainScrnOffset is set to the offset of the first pixel beyond the split
; screen region
;
public _SetSplit
_SetSplit proc far
ARG Line:word
push bp
mov bp,sp ; set up stack frame
push di
mov ax,[Line]
mov _Split_Line,ax
mov bx,_Virtual_Height_Pix
sub bx,ax
mov di,ax
shl di,1
mov di,word ptr _RowOffset[di]
add _Page0_Offset,di
add _Page1_Offset,di
add _Display_Offset,di
add _Draw_Offset,di
dec ax ; Don't ask me why. It works this way !!
jns @@NotNeg ; Check that Split Scrn start scan line is +ve
mov ax,0 ; Since -ve set to 0
@@NotNeg:
push ax ; Save the decremented start scam line
shl ax,1 ; Mode X is actually composed of 480 scan lines
; so for start scanline multiply required ModeX
; scan line by 2
mov [Line],ax ; save the scanline
call _WaitForRetrace ; wait for vertical retrace
mov dx,CRTC_INDEX
mov ah,byte ptr [Line]
mov al,LINE_COMPARE
cli ; Dont allow register setting to be interrupted
out dx,ax ; Bits 7-0 of the split screen scan line
mov ah,byte ptr [Line+1]
and ah,1
mov cl,4
shl ah,cl
mov al,OVERFLOW ; Bit 4 of overflow register = Bit 8 of split
out dx,al ; screen scan line,
inc dx ; So using readability of VGA registers
in al,dx ; Read the OVERFLOW register, and set the
and al, not 10h ; bit corresponding to Bit 8 (above)
or al,ah
out dx,al
dec dx
mov ah,byte ptr [Line+1]
and al,2
mov cl,3
ror ah,cl
mov al,MAX_SCAN_LINE ; Bit 6 of max scan line register =
out dx,al ; Bit 9 of split screen scan line
inc dx ; As we did before, update the apropriate
in al,dx ; bit without disturbing the rest
and al, not 40h
or al,ah
out dx,al
sti ; Registers are set, so interrupts are safe
pop ax ; Determine where the first byte
sub ax,_Physical_Height_Pix ;PHYSICAL_HEIGHT of the non split screen video ram
neg ax ; starts and store it for future
mov bx,_Virtual_Width_Addr ;[_ScrnLogicalByteWidth] ; reference
mul bx
mov _Draw_Offset,ax
; calculate no. non split screen rows in video ram
mov cx,0ffffh ; cx = Maximum video ram offset
sub cx,ax ; cx = cx - _MainScrnOfs
xchg cx,ax ; swap cx and ax
sub dx,dx ; DX:AX is divide operand, set DX = 0
div bx ; divide ax (prev cx) by
; ScrnLogicalByteWidth
mov _Virtual_Height_Addr,ax ;[_ScrnLogicalHeight],ax ; Save Screen Logical Height
sub ax,_Physical_Height_Pix ;PHYSICAL_HEIGHT Update the maximum Y position of
; mov [_MaxScrollY],ax ; Physical screen in logical screen
xchg cx,ax ; restore original ax (MainScrnOfs)
; mov bh,al ; Set the visible screen start address
; mov ch,ah ; to the top left corner of the virtual
; jmp short StartAddrEntry ; screen
pop di
pop bp
ret
_SetSplit endp
;----------------------------------------------------------------------------
; void FlipPage(void);
;
; SWAP(Display,Draw);
; Show(Display);
;
extrn _MousePage_Offset
public _FlipPage
_FlipPage proc
push ds
mov ax,@data
mov ds,ax
mov cx,_Page0_Offset
mov dx,_Page1_Offset
cmp _Current_Page,0
je @@setpage1
@@setpage0:
mov _Current_Page,0
mov _Display_Offset,cx
mov _Draw_Offset,dx
jmp short @@end
@@setpage1:
mov _Current_Page,1
mov _Display_Offset,dx
mov _Draw_Offset,cx
@@end:
mov ax,_Draw_Offset
mov _MousePage_Offset,ax
mov ax,_Display_Offset
; call far ptr _MouseSetPage
push ax
call _ShowPage
pop ax
pop ds
ret
_FlipPage endp
;----------------------------------------------------------------------------
; void RestoreTextMode( void )
public _RestoreTextMode
_RestoreTextMode proc
mov ax,0003h ; set text mode
int 10h
ret
_RestoreTextMode endp
;----------------------------------------------------------------------------
END